home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / gcl-1.000 / gcl-1 / gcl-1.0 / c / sgbc.c < prev    next >
Encoding:
C/C++ Source or Header  |  1993-11-29  |  28.4 KB  |  1,263 lines
  1. /*  Copyright William Schelter. All rights reserved.
  2.     
  3.     Stratified Garbage Collection  (SGC)
  4.  
  5.     Write protects pages to tell which ones have been written
  6. to recently, for more efficient garbage collection.
  7.  
  8. */
  9.  
  10. #ifdef BSD
  11. /* ulong may have been defined in mp.h but the define is no longer needed */
  12. #undef ulong
  13. #include <sys/mman.h>
  14. #define PROT_READ_WRITE (PROT_READ | PROT_WRITE |PROT_EXEC)
  15. #endif
  16. #ifdef AIX3
  17. #include <sys/vmuser.h>
  18. #define PROT_READ RDONLY
  19. #define  PROT_READ_WRITE UDATAKEY
  20. int mprotect();
  21. #endif
  22.  
  23. #include <signal.h>
  24.  
  25. void segmentation_catcher();
  26.  
  27.  
  28. #define sgc_mark_pack_list(u)      \
  29. do {register object xtmp = u;  \
  30.  while (xtmp != Cnil) \
  31.    {if (ON_WRITABLE_PAGE(xtmp)) xtmp->d.m = TRUE; \
  32.      sgc_mark_object(xtmp->c.c_car); \
  33.     xtmp=xtmp->c.c_cdr;}}while(0) 
  34.  
  35.  
  36. #ifdef SDEBUG
  37.   object sdebug;
  38. joe1(){;}
  39. #endif
  40.  
  41. sgc_mark_cons(x)
  42. object x;
  43. {
  44.   cs_check(x);
  45.  
  46.     /*  x is already marked.  */
  47.  
  48. BEGIN:
  49. #ifdef SDEBUG
  50.       if(x==sdebug) joe1();
  51. #endif
  52.       sgc_mark_object(x->c.c_car);
  53. #ifdef OLD
  54.       IF_WRITABLE(x->c.c_car, goto MARK_CAR;);
  55.       goto MARK_CDR;
  56.  
  57.  MARK_CAR:
  58.    if (x->c.c_car->c.m ==0)
  59.     {if (type_of(x->c.c_car) == t_cons)
  60.        {
  61.          x->c.c_car->c.m = TRUE;
  62.          sgc_mark_cons(x->c.c_car);
  63.        }
  64.     else
  65.       sgc_mark_object1(x->c.c_car);}
  66. #endif
  67.  MARK_CDR:  
  68.   x = x->c.c_cdr;
  69.   IF_WRITABLE(x, goto WRITABLE_CDR;);
  70.     return;
  71.  WRITABLE_CDR:
  72.   if (x->d.m) return;
  73.   if (type_of(x) == t_cons) {
  74.         x->c.m = TRUE;
  75.         goto BEGIN;
  76.     }
  77.   sgc_mark_object1(x);
  78. }
  79.  
  80.  
  81. /* Whenever two arrays are linked together by displacement,
  82.    if one is live, the other will be made live */
  83. #define sgc_mark_displaced_field(ar) sgc_mark_object(ar->a.a_displaced)
  84.  
  85.  
  86. /* structures and arrays of type t, need to be marked if their
  87.    bodies are not write protected even if the headers are.
  88.    So we should keep these on pages particular to them.
  89.    Actually we will change structure sets to touch the structure
  90.    header, that way we won't have to keep the headers in memory.
  91.    This takes only 1.47 as opposed to 1.33 microseconds per set.
  92. */
  93. sgc_mark_object1(x)
  94. object x;
  95. {
  96.     int i, j;
  97.     object *p;
  98.     char *cp;
  99.     object y;
  100.  
  101.     cs_check(x);
  102. BEGIN:
  103. #ifdef SDEBUG
  104.     if (x == OBJNULL || !ON_WRITABLE_PAGE(x))
  105.         return;
  106.     IF_WRITABLE(x,goto OK);
  107.     joe();
  108.  
  109.       OK:
  110.     if (x->d.m)
  111.         return;
  112.  
  113.     if(x==sdebug) joe1();
  114. #endif
  115.     x->d.m = TRUE;
  116.     switch (type_of(x)) {
  117.     case t_fixnum:
  118.         break;
  119.  
  120.     case t_ratio:
  121.         sgc_mark_object(x->rat.rat_num);
  122.         x = x->rat.rat_den;
  123.         IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
  124.  
  125.     case t_shortfloat:
  126.         break;
  127.  
  128.     case t_longfloat:
  129.         break;
  130.  
  131.     case t_complex:
  132.         sgc_mark_object(x->cmp.cmp_imag);
  133.         x = x->cmp.cmp_real;
  134.         IF_WRITABLE(x,if(x->d.m==0) goto BEGIN);
  135.  
  136.     case t_character:
  137.         break;
  138.  
  139.     case t_symbol:
  140.         IF_WRITABLE(x->s.s_plist,if(x->s.s_plist->d.m==0)
  141.                 {x->s.s_plist->d.m=TRUE;
  142.                  sgc_mark_cons(x->s.s_plist);});
  143.         sgc_mark_object(x->s.s_gfdef);
  144.         sgc_mark_object(x->s.s_dbind);
  145. /*        do {int xxx= (((int)(char *)(x->s.s_dbind)-0)>>12);
  146.             if((xxx & (-16384) ==0)
  147.                && (sgc_type_map[xxx] & (4 | 1)))
  148.               {if((x->s.s_dbind)->d.m==0)
  149.              sgc_mark_object1(x->s.s_dbind);}} while(0); */
  150.         if (x->s.s_self == NULL)
  151.             break;
  152.         /* to do */
  153.         if ((int)what_to_collect >= (int)t_contiguous) {
  154.             if (inheap(x->s.s_self)) {
  155.                 if (what_to_collect == t_contiguous)
  156.                     mark_contblock(x->s.s_self,
  157.                                x->s.s_fillp);
  158.             } else  if(SGC_RELBLOCK_P(x->s.s_self))
  159.                 x->s.s_self =
  160.                 copy_relblock(x->s.s_self, x->s.s_fillp);
  161.         }
  162.         break;
  163.  
  164.     case t_package:
  165.         sgc_mark_object(x->p.p_name);
  166.         sgc_mark_object(x->p.p_nicknames);
  167.         sgc_mark_object(x->p.p_shadowings);
  168.         sgc_mark_object(x->p.p_uselist);
  169.         sgc_mark_object(x->p.p_usedbylist);
  170.         if (what_to_collect != t_contiguous)
  171.             break;
  172.         if (x->p.p_internal != NULL)
  173.             mark_contblock((char *)(x->p.p_internal),
  174.                        x->p.p_internal_size*sizeof(object));
  175.         if (x->p.p_external != NULL)
  176.             mark_contblock((char *)(x->p.p_external),
  177.                        x->p.p_external_size*sizeof(object));
  178.         break;
  179.  
  180.     case t_cons:
  181. /*
  182.         sgc_mark_object(x->c.c_car);
  183.         x = x->c.c_cdr;
  184.         goto BEGIN;
  185. */
  186.         sgc_mark_cons(x);
  187.         break;
  188.  
  189.     case t_hashtable:
  190.         sgc_mark_object(x->ht.ht_rhsize);
  191.         sgc_mark_object(x->ht.ht_rhthresh);
  192.         if (x->ht.ht_self == NULL)
  193.             break;
  194.         for (i = 0, j = x->ht.ht_size;  i < j;  i++) {
  195.             sgc_mark_object(x->ht.ht_self[i].hte_key);
  196.             sgc_mark_object(x->ht.ht_self[i].hte_value);
  197.         }
  198.         if ((short)what_to_collect >= (short)t_contiguous) {
  199.             if (inheap(x->ht.ht_self)) {
  200.                 if (what_to_collect == t_contiguous)
  201.                     mark_contblock((char *)(x->ht.ht_self),
  202.                                j * sizeof(struct htent));
  203.             } else if(SGC_RELBLOCK_P(x->ht.ht_self))
  204.                 x->ht.ht_self = (struct htent *)
  205.                 copy_relblock((char *)(x->ht.ht_self),
  206.                           j * sizeof(struct htent));
  207.         }
  208.         break;
  209.  
  210.     case t_array:
  211.         if ((x->a.a_displaced) != Cnil)
  212.           sgc_mark_displaced_field(x);
  213.         if ((int)what_to_collect >= (int)t_contiguous &&
  214.             x->a.a_dims != NULL) {
  215.             if (inheap(x->a.a_dims)) {
  216.                 if (what_to_collect == t_contiguous)
  217.                     mark_contblock((char *)(x->a.a_dims),
  218.                                sizeof(int)*x->a.a_rank);
  219.             } else  if(SGC_RELBLOCK_P(x->a.a_dims))
  220.                 x->a.a_dims = (int *)
  221.                 copy_relblock((char *)(x->a.a_dims),
  222.                           sizeof(int)*x->a.a_rank);
  223.         }
  224.         if ((enum aelttype)x->a.a_elttype == aet_ch)
  225.             goto CASE_STRING;
  226.         if ((enum aelttype)x->a.a_elttype == aet_bit)
  227.             goto CASE_BITVECTOR;
  228.         if ((enum aelttype)x->a.a_elttype == aet_object)
  229.             goto CASE_GENERAL;
  230.  
  231.     CASE_SPECIAL:
  232.         cp = (char *)(x->fixa.fixa_self);
  233.         if (cp == NULL)
  234.             break;
  235.         /* set j to the size in char of the body of the array */
  236.         
  237.         switch((enum aelttype)x->a.a_elttype){
  238.         case aet_lf:
  239.           j= sizeof(longfloat)*x->lfa.lfa_dim;
  240.           if (((int)what_to_collect >= (int)t_contiguous) &&
  241.             !(inheap(cp)) && SGC_RELBLOCK_P(x->a.a_self))
  242.             ROUND_RB_POINTERS_DOUBLE;
  243.           break;
  244.         case aet_char:
  245.         case aet_uchar:
  246.           j=sizeof(char)*x->a.a_dim;
  247.           break;
  248.         case aet_short:
  249.         case aet_ushort:
  250.           j=sizeof(short)*x->a.a_dim;
  251.           break;
  252.         default:
  253.           j=sizeof(fixnum)*x->fixa.fixa_dim;}
  254.  
  255.         goto COPY;
  256.  
  257.     CASE_GENERAL:
  258.         p = x->a.a_self;
  259.         if (p == NULL
  260. #ifdef HAVE_ALLOCA
  261.                    || (char *)p >= core_end
  262. #endif  
  263.             
  264.             )
  265.             break;
  266.         if (x->a.a_displaced->c.c_car == Cnil)
  267.             for (i = 0, j = x->a.a_dim;  i < j;  i++)
  268.               if (ON_WRITABLE_PAGE(&p[i]))
  269.                 sgc_mark_object(p[i]);
  270.         cp = (char *)p;
  271.         j *= sizeof(object);
  272.     COPY:
  273.         if ((int)what_to_collect >= (int)t_contiguous) {
  274.             if (inheap(cp)) {
  275.                 if (what_to_collect == t_contiguous)
  276.                     mark_contblock(cp, j);
  277.             }
  278.             else if (!SGC_RELBLOCK_P(cp)) ;
  279.             else if (x->a.a_displaced == Cnil)
  280.                 x->a.a_self = (object *)copy_relblock(cp, j);
  281.             else if (x->a.a_displaced->c.c_car == Cnil) {
  282.                 i = (int)(object *)copy_relblock(cp, j)
  283.                   - (int)(x->a.a_self);
  284.                 adjust_displaced(x, i);
  285.             }
  286.         }
  287.         break;
  288.  
  289.     case t_vector:
  290.         if ((x->v.v_displaced) != Cnil)
  291.           sgc_mark_displaced_field(x);
  292.         if ((enum aelttype)x->v.v_elttype == aet_object)
  293.             goto CASE_GENERAL;
  294.         else
  295.             goto CASE_SPECIAL;
  296.  
  297.         case t_bignum:
  298.         if ((int)what_to_collect >= (int)t_contiguous) {
  299.         j = x->big.big_length;
  300.         cp = (char *)x->big.big_self;
  301.         if (cp == NULL)
  302.             break;
  303.         if  (j != lg(MP(x))  &&
  304.               /* we don't bother to zero this register,
  305.              and its contents may get over written */
  306.               ! (x ==  big_register_1 &&
  307.              (int)(cp) <= top &&
  308.              (int) cp >= bot))
  309.           
  310.           printf("bad length 0x%x ",x);
  311.         j = j * sizeof(int);
  312.                 cp = (char *)MP(x);
  313.         if (inheap(cp)) {
  314.           if (what_to_collect == t_contiguous)
  315.             mark_contblock(cp, j);
  316.         } else 
  317.           x->big.big_self = (long *)copy_relblock(cp, j);}
  318.         break;
  319.         
  320.  
  321.     CASE_STRING:
  322.     case t_string:
  323.         if ((x->st.st_displaced) != Cnil)
  324.           sgc_mark_displaced_field(x);
  325.         j = x->st.st_dim;
  326.         cp = x->st.st_self;
  327.         if (cp == NULL)
  328.             break;
  329.  
  330.     COPY_STRING:
  331.         if ((int)what_to_collect >= (int)t_contiguous) {
  332.             if (inheap(cp)) {
  333.                 if (what_to_collect == t_contiguous)
  334.                     mark_contblock(cp, j);
  335.             }
  336.             else if (!SGC_RELBLOCK_P(cp)) ;
  337.             else if (x->st.st_displaced == Cnil)
  338.                 x->st.st_self = copy_relblock(cp, j);
  339.             else if (x->st.st_displaced->c.c_car == Cnil) {
  340.                 i = copy_relblock(cp, j) - cp;
  341.                 adjust_displaced(x, i);
  342.             }
  343.         }
  344.         break;
  345.  
  346.     CASE_BITVECTOR:
  347.     case t_bitvector:
  348.         if ((x->bv.bv_displaced) != Cnil)
  349.           sgc_mark_displaced_field(x);
  350. /* We make bitvectors multiple of sizeof(int) in size allocated
  351.  Assume 8 = number of bits in char */
  352.  
  353. #define W_SIZE (8*sizeof(int))
  354.         j= sizeof(int) *
  355.            ((x->bv.bv_offset + x->bv.bv_dim + W_SIZE -1)/W_SIZE);
  356.         cp = x->bv.bv_self;
  357.         if (cp == NULL)
  358.             break;
  359.         goto COPY_STRING;
  360.  
  361.     case t_structure:
  362.         sgc_mark_object(x->str.str_def);
  363.         p = x->str.str_self;
  364.         if (p == NULL)
  365.             break;
  366.         {object def=x->str.str_def;
  367.          unsigned char * s_type = &SLOT_TYPE(def,0);
  368.          unsigned short *s_pos= & SLOT_POS(def,0);
  369.          for (i = 0, j = S_DATA(def)->length;  i < j;  i++)
  370.            if (s_type[i]==0 &&
  371.                ON_WRITABLE_PAGE(& STREF(object,x,s_pos[i]))
  372.                )
  373.              sgc_mark_object(STREF(object,x,s_pos[i]));
  374.          if ((int)what_to_collect >= (int)t_contiguous) {
  375.              if (inheap(x->str.str_self)) {
  376.                if (what_to_collect == t_contiguous)
  377.              mark_contblock((char *)p,
  378.                     S_DATA(def)->size);
  379.  
  380.              } else if(SGC_RELBLOCK_P(p))
  381.                x->str.str_self = (object *)
  382.               copy_relblock((char *)p, S_DATA(def)->size);
  383.            }}
  384.         break;
  385.  
  386.     case t_stream:
  387.         switch (x->sm.sm_mode) {
  388.         case smm_input:
  389.         case smm_output:
  390.         case smm_io:
  391.         case smm_probe:
  392.             sgc_mark_object(x->sm.sm_object0);
  393.             sgc_mark_object(x->sm.sm_object1);
  394.             if (saving_system)
  395.               {FILE *fp = x->sm.sm_fp;
  396.                  if (fp != 0 && fp != stdin && fp !=stdout
  397.                  )
  398.                  {fclose(fp);
  399.                   x->sm.sm_fp=0;
  400.                 }}
  401.             else
  402.             if (what_to_collect == t_contiguous &&
  403.                 x->sm.sm_fp &&
  404.                 x->sm.sm_buffer)
  405.                 mark_contblock(x->sm.sm_buffer, BUFSIZ);
  406.             break;
  407.  
  408.         case smm_synonym:
  409.             sgc_mark_object(x->sm.sm_object0);
  410.             break;
  411.  
  412.         case smm_broadcast:
  413.         case smm_concatenated:
  414.             sgc_mark_object(x->sm.sm_object0);
  415.             break;
  416.  
  417.         case smm_two_way:
  418.         case smm_echo:
  419.             sgc_mark_object(x->sm.sm_object0);
  420.             sgc_mark_object(x->sm.sm_object1);
  421.             break;
  422.  
  423.         case smm_string_input:
  424.         case smm_string_output:
  425.             sgc_mark_object(x->sm.sm_object0);
  426.             break;
  427. #ifdef USER_DEFINED_STREAMS
  428.                case smm_user_defined:
  429.             sgc_mark_object(x->sm.sm_object0);
  430.             sgc_mark_object(x->sm.sm_object1);
  431.             break;
  432. #endif
  433.         default:
  434.             error("mark stream botch");
  435.         }
  436.         break;
  437.  
  438.     case t_random:
  439.         break;
  440.  
  441.     case t_readtable:
  442.         if (x->rt.rt_self == NULL)
  443.             break;
  444.         if (what_to_collect == t_contiguous)
  445.             mark_contblock((char *)(x->rt.rt_self),
  446.                        RTABSIZE*sizeof(struct rtent));
  447.         for (i = 0;  i < RTABSIZE;  i++) {
  448.             sgc_mark_object(x->rt.rt_self[i].rte_macro);
  449.             if (x->rt.rt_self[i].rte_dtab != NULL) {
  450. /**/
  451.     if (what_to_collect == t_contiguous)
  452.         mark_contblock((char *)(x->rt.rt_self[i].rte_dtab),
  453.                    RTABSIZE*sizeof(object));
  454.     for (j = 0;  j < RTABSIZE;  j++)
  455.         sgc_mark_object(x->rt.rt_self[i].rte_dtab[j]);
  456. /**/
  457.             }
  458.         }
  459.         break;
  460.  
  461.     case t_pathname:
  462.         sgc_mark_object(x->pn.pn_host);
  463.         sgc_mark_object(x->pn.pn_device);
  464.         sgc_mark_object(x->pn.pn_directory);
  465.         sgc_mark_object(x->pn.pn_name);
  466.         sgc_mark_object(x->pn.pn_type);
  467.         sgc_mark_object(x->pn.pn_version);
  468.         break;
  469.  
  470.     case t_cfun:
  471.         case t_sfun:
  472.         case t_vfun:
  473.     case t_gfun:    
  474.         sgc_mark_object(x->cf.cf_name);
  475.         sgc_mark_object(x->cf.cf_data);
  476.         break;
  477.         
  478.         case t_cfdata:
  479.  
  480.             if (x->cfd.cfd_self != NULL)
  481.           {int i=x->cfd.cfd_fillp;
  482.            while(i-- > 0)
  483.              sgc_mark_object(x->cfd.cfd_self[i]);}
  484.         if (x->cfd.cfd_start == NULL)
  485.             break;
  486.         if (what_to_collect == t_contiguous) {
  487.             if (!MAYBE_DATA_P((x->cfd.cfd_start)) ||
  488.                 get_mark_bit((int *)(x->cfd.cfd_start)))
  489.                 break;
  490.             mark_contblock(x->cfd.cfd_start, x->cfd.cfd_size);}
  491.         break;
  492.     case t_cclosure:
  493.         sgc_mark_object(x->cc.cc_name);
  494.         sgc_mark_object(x->cc.cc_env);
  495.                 sgc_mark_object(x->cc.cc_data);
  496.         if (what_to_collect == t_contiguous) {
  497.           if (x->cc.cc_turbo != NULL)
  498.             mark_contblock((char *)(x->cc.cc_turbo-1),
  499.                                    (1+fix(*(x->cc.cc_turbo-1)))*sizeof(object));
  500.         }
  501.         break;
  502.  
  503.     case t_spice:
  504.         break;
  505.         case t_fat_string:
  506.         mark_fat_string(x);
  507.         break;
  508.         case t_dclosure:
  509.                 break;
  510.     default:
  511. #ifdef DEBUG
  512.         if (debug)
  513.             printf("\ttype = %d\n", type_of(x));
  514. #endif
  515.         error("mark botch");
  516.     }
  517.     
  518. }
  519.  
  520.  
  521.  
  522. sgc_mark_stack_carefully(top,bottom,offset)
  523. int *bottom,*top;
  524. {int p,m,pageoffset;
  525.  object x;
  526.  struct typemanager *tm;
  527.  register int *j;
  528.  
  529.  /* if either of these happens we are marking the C stack
  530.     and need to use a local */
  531.  
  532.  if (top==0) top = c_stack_where;
  533.  if (bottom==0) bottom= c_stack_where;
  534.  
  535.  /* On machines which align local pointers on multiple of 2 rather
  536.     than 4 we need to mark twice
  537.    */
  538.  
  539.  if (offset) {sgc_mark_stack_carefully(bottom,(((char *) top) +offset),0);}
  540.  for (j=top ; j >= bottom ; j--)
  541.    {if (VALID_DATA_ADDRESS_P(*j)
  542.     && type_map[(p=page(*j))]< (char)t_end)
  543.       {pageoffset=((char *)*j - pagetochar(p));
  544.        tm=tm_of((enum type) type_map[p]);
  545.        x= (object)
  546.      ((char *)(*j) -
  547.       ((pageoffset=((char *)*j - pagetochar(p))) %
  548.        tm->tm_size));
  549.        if ((pageoffset <  (tm->tm_size * tm->tm_nppage))
  550.        && (m=x->d.m) != FREE)
  551.        {if (m==TRUE) continue;
  552.       if (m!=0)
  553.         {fprintf(stdout,
  554.              "**bad value %d of d.m in gbc page %d skipping mark**"
  555.              ,m,p);fflush(stdout);
  556.          continue;
  557.        };
  558.       sgc_mark_object(x);}}}}
  559.  
  560.  
  561. sgc_mark_phase()
  562. {
  563.     STATIC object *p;
  564.     STATIC int i, j, k, n;
  565.     STATIC struct package *pp;
  566.     STATIC object s, l, *lp;
  567.     STATIC bds_ptr bdp;
  568.     STATIC frame_ptr frp;
  569.     STATIC ihs_ptr ihsp;
  570.     STATIC char *cp;
  571.  
  572.     sgc_mark_object(Cnil);
  573.     sgc_mark_object(Ct);
  574.  
  575.     
  576.  
  577.     /* mark all non recent data on writable pages */
  578.     {int t,i=page(heap_end);
  579.      struct typemanager *tm;
  580.      char *p;
  581.      
  582.      while (--i >= 0)
  583.        {if (WRITABLE_PAGE_P(i)
  584.           && (t=type_map[i]) < (int) t_end);
  585.        else continue;
  586.         tm=tm_of(t);
  587.         p=pagetochar(i);
  588.         if ( t == t_cons) 
  589.           for (j = tm->tm_nppage; --j >= 0; p += sizeof(struct cons))
  590.           {object x = (object) p; 
  591.            if (SGC_OR_M(x)) continue;
  592.            if (x->d.t==t_cons) {x->d.m = TRUE; sgc_mark_cons(x);}
  593.            else
  594.          sgc_mark_object1(x);
  595.          }
  596.         else
  597.           {int size=tm->tm_size;
  598.            for (j = tm->tm_nppage; --j >= 0; p += size)
  599.          {object x = (object) p; 
  600.           if (SGC_OR_M(x)) continue;
  601.           sgc_mark_object1(x);
  602.         }}}}
  603.  
  604.  
  605.     sgc_mark_stack_carefully(vs_top-1,vs_org,0);
  606.     clear_stack(vs_top,vs_limit);
  607.     sgc_mark_stack_carefully(MVloc,MVloc+(sizeof(MVloc)/sizeof(object)),0);
  608.     /* 
  609.     for (p = vs_org;  p < vs_top;  p++) {
  610.       if (p && (inheap(*p)))
  611.         sgc_mark_object(*p);
  612.     }
  613.     */
  614. #ifdef DEBUG
  615.     if (debug) {
  616.         printf("value stack marked\n");
  617.         fflush(stdout);
  618.     }
  619. #endif
  620.  
  621.     for (bdp = bds_org;  bdp<=bds_top;  bdp++) {
  622.          sgc_mark_object(bdp->bds_sym);
  623.         sgc_mark_object(bdp->bds_val);
  624.     }
  625.  
  626.     for (frp = frs_org;  frp <= frs_top;  frp++)
  627.         sgc_mark_object(frp->frs_val);
  628.  
  629.     for (ihsp = ihs_org;  ihsp <= ihs_top;  ihsp++)
  630.         sgc_mark_object(ihsp->ihs_function);
  631.  
  632.     for (i = 0;  i < mark_origin_max;  i++)
  633.         sgc_mark_object(*mark_origin[i]);
  634.     for (i = 0;  i < mark_origin_block_max;  i++)
  635.         for (j = 0;  j < mark_origin_block[i].mob_size;  j++)
  636.             sgc_mark_object(mark_origin_block[i].mob_addr[j]);
  637.  
  638.     for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link)
  639.         sgc_mark_object((object)pp);
  640. #ifdef KCLOVM
  641.     if (ovm_process_created)
  642.       sgc_mark_all_stacks();
  643. #endif
  644.  
  645.  
  646.     if (debug) {
  647.         printf("symbol navigation\n");
  648.         fflush(stdout);
  649.     }
  650.     {int size;
  651.      
  652.      for (pp = pack_pointer;  pp != NULL;  pp = pp->p_link) {
  653.                     size = pp->p_internal_size;
  654.             if (pp->p_internal != NULL)
  655.                 for (i = 0;  i < size;  i++)
  656.                     sgc_mark_pack_list(pp->p_internal[i]);
  657.             size = pp->p_external_size;
  658.             if (pp->p_external != NULL)
  659.                 for (i = 0;  i < size;  i++)
  660.                     sgc_mark_pack_list(pp->p_external[i]);
  661.         }}
  662.  
  663.  
  664.     mark_c_stack(0,N_RECURSION_REQD,sgc_mark_stack_carefully);
  665.  
  666. }
  667.  
  668. sgc_sweep_phase()
  669. {
  670.     STATIC int i, j, k;
  671.     STATIC object x;
  672.     STATIC char *p;
  673.     STATIC int *ip;
  674.     STATIC struct typemanager *tm;
  675.     STATIC object f;
  676.     int size;
  677.  
  678.     Cnil->s.m = FALSE;
  679.     Ct->s.m = FALSE;
  680.  
  681. #ifdef DEBUG
  682.     if (debug)
  683.         printf("type map\n");
  684. #endif
  685.     for (i = 0;  i < maxpage;  i++) {
  686.         if (type_map[i] == (int)t_contiguous) {
  687.             if (debug) {
  688.                 printf("-");
  689.             /*
  690.                 fflush(stdout);
  691.             */
  692.                 continue;
  693.             }
  694.         }
  695.         if (type_map[i] >= (int)t_end)
  696.             continue;
  697.  
  698.         tm = tm_of((enum type)type_map[i]);
  699.  
  700.     /*
  701.         general sweeper
  702.     */
  703.  
  704. #ifdef DEBUG
  705.         if (debug) {
  706.             printf("%c", tm->tm_name[0]);
  707.         /*
  708.             fflush(stdout);
  709.         */
  710.         }
  711. #endif
  712.         if (!WRITABLE_PAGE_P(i)) continue;
  713.         p = pagetochar(i);
  714.         f = tm->tm_free;
  715.         k = 0;
  716.         size=tm->tm_size;
  717.         if (SGC_PAGE_P(i)) {
  718.         for (j = tm->tm_nppage; --j >= 0;  p += size) {
  719.             x = (object)p;
  720.  
  721.             if (x->d.m == FREE)
  722.                 continue;
  723.             else if (x->d.m) {
  724.                 x->d.m = FALSE;
  725.                 continue;
  726.             }
  727.             if(x->d.s == SGC_NORMAL)
  728.               continue;
  729.             
  730.             /* it is ok to free x */
  731.             
  732. #ifdef OLD_DISPLACE
  733.             /* old_displace: from might be free, to not */
  734.             if(x->d.t >=t_array && x->d.t <= t_bitvector)
  735.               {
  736.                 /*            case t_array:
  737.                         case t_vector:
  738.                         case t_string:
  739.                         case t_bitvector:
  740.                         */            
  741.                 if (x->a.a_displaced->c.c_car != Cnil)
  742.                   {undisplace(x);
  743.          /* The cons x->a.a_displaced cons has been saved,
  744.             so as to save the pointer to x->a.a_displaced->c.c_car;
  745.             However any arrays in its cdr, must have been
  746.             freed, or we would not be freeing x.   To avoid
  747.             having a cons with trash in the cdr we set the
  748.             cdr to nil
  749.             */                    
  750.                  x->a.a_displaced->c.c_cdr = Cnil;}
  751.             }
  752. #endif OLD_DISPLACE
  753.             ((struct freelist *)x)->f_link = f;
  754.             x->d.m = FREE;
  755.             x->d.s = (int)SGC_RECENT;
  756.             f = x;
  757.             k++;
  758.         }
  759.         tm->tm_free = f;
  760.         tm->tm_nfree += k;
  761.           }
  762.         else /*non sgc_page */
  763.         for (j = tm->tm_nppage; --j >= 0;  p += size) {
  764.             x = (object)p;
  765.  
  766.             if (x->d.m == TRUE) x->d.m=FALSE;
  767.         }
  768.           
  769.  
  770.     NEXT_PAGE:
  771.         ;
  772.     }
  773. #ifdef DEBUG
  774.     if (debug) {
  775.         putchar('\n');
  776.         fflush(stdout);
  777.     }
  778. #endif
  779. }
  780.  
  781.  
  782. sgc_contblock_sweep_phase()
  783. {
  784.     STATIC int i, j;
  785.     STATIC char *s, *e, *p, *q;
  786.     STATIC struct contblock *cbp;
  787.  
  788.     cb_pointer = NULL;
  789.     ncb = 0;
  790.     for (i = 0;  i < maxpage;) {
  791.         if (type_map[i] != (int)t_contiguous
  792.             || !SGC_PAGE_P(i))
  793.              {
  794.             i++;
  795.             continue;
  796.         }
  797.         for (j = i+1;
  798.              j < maxpage && type_map[j] == (int)t_contiguous
  799.              && SGC_PAGE_P(j)
  800.              ;
  801.              j++)
  802.             ;    
  803.         s = pagetochar(i);
  804.         e = pagetochar(j);
  805.         for (p = s;  p < e;) {
  806.             if (get_mark_bit((int *)p)) {
  807.                 p += 4;
  808.                 continue;
  809.             }
  810.             q = p + 4;
  811.             while (q < e) {
  812.                 if (!get_mark_bit((int *)q)) {
  813.                     q += 4;
  814.                     continue;
  815.                 }
  816.                 break;
  817.             }
  818.             insert_contblock(p, q - p);
  819.             p = q + 4;
  820.         }
  821.         i = j + 1;
  822.     }
  823. #ifdef DEBUG
  824.     if (debug) {
  825.         for (cbp = cb_pointer; cbp != NULL; cbp = cbp->cb_link)
  826.             printf("%d-byte contblock\n", cbp->cb_size);
  827.         fflush(stdout);
  828.     }
  829. #endif
  830. }
  831.  
  832.  
  833.  
  834. #define PAGE_ROUND_UP(adr) \
  835.     ((char *)(PAGESIZE*(((int)(adr)+PAGESIZE -1) >> PAGEWIDTH)))
  836.  
  837. char *old_rb_start;
  838.  
  839. #undef tm
  840.  int bug1,bug2;
  841.  
  842.  
  843. #ifdef SDEBUG
  844. sgc_count(yy)
  845.      object yy;
  846. {int count=0;
  847.  object y=yy;
  848.  while(y)
  849.    {count++;
  850.     y=F_LINK(y);}
  851.  printf("[length %x = %d]",yy,count);
  852.  fflush(stdout);
  853. }
  854.  
  855. #endif
  856. /* count writable pages excluding the hole */
  857. sgc_count_writable(end)
  858.      int end;
  859. { int j = first_protectable_page -1;
  860.   int count = 0;
  861.   int hp_end= page(heap_end);
  862.   while(j++ < hp_end)
  863.     if (WRITABLE_PAGE_P(j)) count++;
  864.   j= page(rb_start);
  865.   while(j++ < end)
  866.     if (WRITABLE_PAGE_P(j)) count++;
  867.   return count;}
  868.  
  869.  
  870. sgc_count_type(t)
  871.      int t;
  872. {int j = first_protectable_page -1;
  873.   int end = page(core_end);
  874.   int count=0;
  875.   while(j++ < end)
  876.     if (type_map[j]==t && SGC_PAGE_P(j))
  877.       count++;
  878.   return count;}
  879.  
  880.  
  881.  
  882.  
  883.  
  884. sgc_start()
  885. {int i;
  886.  int np;
  887.  int bug;
  888.  short free_map[MAXPAGE];
  889.  object f, fr[(int)t_end];
  890.  struct typemanager *tm;
  891.  int npages;
  892.  if (sgc_type_map[page((&sgc_type_map[0]))] != SGC_PERM_WRITABLE )
  893.    {perm_writable(&sgc_type_map[0],sizeof(sgc_type_map));
  894.   }
  895.  if (sgc_enabled)
  896.      return 1;
  897.  sgc_type_map[0]=0;
  898. AGAIN:
  899.  i=npages=page(core_end);
  900.  while (i--> 0)
  901.    sgc_type_map[i] = sgc_type_map[i]  & SGC_PERM_WRITABLE ;
  902.  
  903.  for (i= t_start; i < t_contiguous ; i++)
  904.    if (TM_BASE_TYPE_P(i) && (np=(tm=tm_of(i))->tm_sgc))
  905.      FIND_FREE_PAGES:
  906.      {
  907.        int maxp=0;
  908.        int j;
  909.        int minfree = tm->tm_sgc_minfree;
  910.        int count,tm_sgc;
  911.        bzero(free_map,npages*sizeof(short));
  912.        f = tm->tm_free;
  913.        count=0;
  914.        while (f!=0)
  915.      {free_map[j=page(f)]++;
  916.       if (j>=maxp) maxp=j;
  917. #ifdef DEBUG
  918.       count++;
  919. #endif      
  920.       f= F_LINK(f);
  921.     }
  922. #ifdef DEBUG       
  923.        if (count!=tm->tm_nfree)
  924.      {printf("[Count differed type(%d)nfree= %d in freelist %d]\n"
  925.          ,tm->tm_type,tm->tm_nfree,
  926.          count);fflush(stdout);}
  927. #endif       
  928.        for(j=0,count=0; j <= maxp ;j++)
  929.      {if (free_map[j] >= minfree)
  930.         {sgc_type_map[j] |= (SGC_PAGE_FLAG | SGC_TEMP_WRITABLE);
  931.          ++count;
  932.         if (count >= tm->tm_sgc_max)
  933.            break; 
  934.        }}
  935.  
  936.        /* don't do any more allocations  for this type if saving system */
  937.        if (saving_system) continue;
  938.        
  939.        if (count < tm->tm_sgc)
  940.      /* try to get some more free pages of type i */
  941.      { int n = tm->tm_sgc - count;
  942.        int again=0,nfree = tm->tm_nfree;
  943.        char *p=alloc_page(n);
  944.        if (tm->tm_nfree > nfree) again=1;  /* gc freed some objects */
  945.        while (n-- > 0)
  946.          {(sgc_enabled=1,add_page_to_freelist(p,tm),sgc_enabled=0);
  947.           p += PAGESIZE;}
  948.        if (again) goto FIND_FREE_PAGES;     }}
  949.   /* Now  allocate the sgc relblock.   We do this as the tail
  950.     end of the ordinary rb.     */  
  951.   {int want;
  952.   char *new;
  953.   tm=tm_of(t_relocatable);
  954.   want =((int) (rb_end - rb_pointer) >> PAGEWIDTH);
  955.   if (want < tm->tm_sgc) want = tm->tm_sgc;
  956.    else { want  = (want < 4 ? want : want -2);}
  957.  
  958.  FINALE:
  959.   {old_rb_start=rb_start;
  960.    if(!saving_system)
  961.    { new=alloc_relblock(want*PAGESIZE);
  962.     new= PAGE_ROUND_UP(new);
  963.     rb_start=rb_pointer=new;
  964.   }}}
  965.    /* the relblock has been allocated */
  966.  
  967.   /* now move the sgc free lists into place.   alt_free should
  968.      contain the others */
  969.  
  970.   for (i= t_start; i < t_contiguous ; i++)
  971.     if ((bug1= TM_BASE_TYPE_P(i))
  972.     && (np=(tm=tm_of(i))->tm_sgc))
  973.       {object f=tm->tm_free ,x,y,next;
  974.        int count=0;
  975.        x=y=0;
  976.        bug2=(tm_table[i].tm_type == (enum type) i);
  977.       while (f!=0)
  978.         {next=F_LINK(f);
  979. #ifdef SDEBUG         
  980.          if (f->d.m!=FREE)
  981.            printf("Not FREE in freelist f=%d",f);
  982. #endif
  983.          if (ON_SGC_PAGE(f))
  984.            { F_LINK(f) =x;
  985.          f->d.s = SGC_RECENT;
  986.          x=f;
  987.          count++;
  988.            }
  989.          else
  990.            {F_LINK(f)=y;
  991.         f->d.s = SGC_NORMAL;
  992.         y=f;}
  993.          f=next;
  994.        }
  995.     tm->tm_free = x;
  996.     tm->tm_alt_free = y;
  997.     tm->tm_alt_nfree = tm->tm_nfree - count;
  998.     tm->tm_nfree=count;
  999.      }
  1000.    
  1001.    /* Whew.   We have now allocated the sgc space
  1002.       and modified the tm_table;
  1003.       Turn  memory protection on for the pages which are writable.
  1004.     */
  1005.    memory_protect(1);
  1006.    sgc_enabled=1;
  1007.   if(siVnotify_gbc->s.s_dbind != Cnil)
  1008.    {printf("[SGC on]"); fflush(stdout);}
  1009.  
  1010. }
  1011.  
  1012. sgc_quit()
  1013. { struct typemanager *tm;
  1014.   int i,np;
  1015.   memory_protect(0);
  1016.   if(siVnotify_gbc->s.s_dbind != Cnil)
  1017.    {printf("[SGC off]"); fflush(stdout);}
  1018.   if (sgc_enabled==0) return 0;
  1019.   sgc_enabled=0;
  1020.   rb_start = old_rb_start;
  1021.   for (i= t_start; i < t_contiguous ; i++)
  1022.    if (TM_BASE_TYPE_P(i))
  1023.      {tm=tm_of(i);
  1024.      if (np=tm->tm_sgc)
  1025.        {object f,y;
  1026.     f=tm->tm_free;
  1027.     if (f==0) tm->tm_free=tm->tm_alt_free;
  1028.     else
  1029.       /* tack the alt_free onto the end of free */
  1030.       {
  1031. #ifdef SDEBUG
  1032.         int count=0;
  1033.         f=tm->tm_free;
  1034.         while(y= F_LINK(f))
  1035.           {if(y->d.s != SGC_RECENT)
  1036.         printf("[bad %d]",y);
  1037.            count++; f=y;}
  1038.  
  1039.         count=0;
  1040.         if (f=tm->tm_alt_free)
  1041.           while(y= F_LINK(f))
  1042.         {
  1043.           if(y->d.s != SGC_NORMAL)
  1044.             printf("[alt_bad %d]",y);
  1045.           count++; f=y;}
  1046.         
  1047. #endif
  1048.         f=tm->tm_free;
  1049.         while(y= F_LINK(f))
  1050.          f=y;
  1051.        F_LINK(f)=tm->tm_alt_free;
  1052.        }
  1053.     /* tm->tm_free has all of the free objects */
  1054.     tm->tm_nfree += tm->tm_alt_nfree;
  1055.     tm->tm_alt_nfree = 0;
  1056.     tm->tm_alt_free = 0;
  1057.     
  1058.     /* remove the recent flag from any objects on sgc pages */
  1059.     {int hp=page(heap_end);
  1060.      int i,j;
  1061.      char t = (char) tm->tm_type;
  1062.      char *p;
  1063.            for (i=0 ; i < hp; i++)
  1064.          if (type_map[i]==t && (sgc_type_map[i] & SGC_PAGE_FLAG))
  1065.                for (p= pagetochar(i),j = tm->tm_nppage;
  1066.              j > 0; --j, p += tm->tm_size)
  1067.           {((object) p)->d.s = SGC_NORMAL;}}
  1068.  
  1069.  
  1070.  
  1071.       }}
  1072. }
  1073.  
  1074. void
  1075. make_writable(beg,i)
  1076.      int beg,i;
  1077. {if (i > beg)
  1078.    {beg=ROUND_DOWN_PAGE_NO(beg);
  1079.     i=ROUND_UP_PAGE_NO(i);
  1080.     {int k=beg;
  1081.      while(k <i )
  1082.        sgc_type_map[k++] |= SGC_TEMP_WRITABLE;
  1083.      }
  1084.     sgc_mprotect(beg, i-beg, SGC_WRITABLE);
  1085.     ;}
  1086. }
  1087.  
  1088. int debug_fault =0;
  1089. int fault_count =0;
  1090. extern char *etext;
  1091. void
  1092. memprotect_handler(sig, code, scp, addr)
  1093.           int sig, code;
  1094.           struct sigcontext *scp;
  1095.           char *addr;     
  1096. {int p;
  1097.  int j=page_multiple;
  1098. #ifdef GET_FAULT_ADDR
  1099.  addr=GET_FAULT_ADDR(sig,code,scp,addr);
  1100.  debug_fault = (int) addr;
  1101. #ifdef DEBUG_MPROTECT
  1102.  printf("fault:0x%x [%d] (%d)",addr,page(addr),addr >= core_end);
  1103. #endif 
  1104.  if (addr >= core_end || (unsigned int)addr < DBEGIN)
  1105.    {if (fault_count > 300) error("fault count to high");
  1106.       fault_count ++;
  1107.         INSTALL_MPROTECT_HANDLER;
  1108.     return;}
  1109.    
  1110. #endif 
  1111.  p = page(addr);
  1112.  p = ROUND_DOWN_PAGE_NO(p);
  1113.  if (p >= first_protectable_page
  1114.      && addr < core_end
  1115.      && !(WRITABLE_PAGE_P(p)))
  1116.    {/*   CHECK_RANGE(p,1); */
  1117. #ifdef DEBUG_MPROTECT
  1118.      printf("mprotect(0x%x,%x,0x%x)\n",pagetochar(p),page_multiple * PAGESIZE, sbrk(0));
  1119.      fflush(stdout);
  1120. #endif     
  1121.      mprotect(pagetochar(p),page_multiple * PAGESIZE, PROT_READ_WRITE);
  1122.     while (--j >= 0)
  1123.       sgc_type_map[p+j]=      sgc_type_map[p+j] | SGC_TEMP_WRITABLE;
  1124.  
  1125. #ifndef  BSD
  1126.  INSTALL_MPROTECT_HANDLER;
  1127. #endif
  1128.  
  1129.     return;
  1130.   }
  1131.  
  1132. #ifndef  BSD
  1133.  INSTALL_MPROTECT_HANDLER;
  1134. #endif
  1135. /* if (SIGSEGV == SIGPROTV) */
  1136.  END:
  1137.  segmentation_catcher();
  1138.  return;
  1139. }
  1140.  
  1141. sgc_mprotect(pbeg,n,writable)
  1142. { /* CHECK_RANGE(pbeg,n);  */
  1143. #ifdef DEBUG_MPROTECT
  1144.   printf("prot[%d,%d,(%d),%s]\n",pbeg,pbeg+n,writable & SGC_WRITABLE,
  1145.      (writable  & SGC_WRITABLE ? "writable" : "not writable"));
  1146.   fflush(stdout);
  1147. #endif  
  1148.   if(mprotect(pagetochar(pbeg),n*PAGESIZE,
  1149.          (writable & SGC_WRITABLE ? PROT_READ_WRITE : PROT_READ)))
  1150.    FEerror("Couldn't protect");}
  1151.  
  1152.  
  1153. /* for page numbers from beg below end,
  1154.    if one page in a a page_multiple grouping is writable,the
  1155.    rest must be */
  1156.  
  1157. fix_for_page_multiple(beg,end)
  1158. {int i,j;
  1159.  char *p;
  1160.  int writable;
  1161.  beg = ROUND_DOWN_PAGE_NO(beg);
  1162.  for (i = beg ; i < end; i = i+ page_multiple){
  1163.    p = sgc_type_map + i;
  1164.    j = page_multiple;
  1165.    writable = ((*p++) & SGC_WRITABLE);
  1166.    if (writable)
  1167.      /* all pages must be */
  1168.      { while (--j)
  1169.      if (((*p++) & SGC_WRITABLE)  == 0)
  1170.        goto FIXIT;}
  1171.    else
  1172.      { while (--j)
  1173.      if ((*p++) & SGC_WRITABLE ) 
  1174.        goto FIXIT;}
  1175.    continue;
  1176.  FIXIT:
  1177.    j = page_multiple;
  1178.    p = sgc_type_map + i;
  1179.    while (--j >= 0 )
  1180.      { (*p++) |= SGC_WRITABLE;}}}
  1181.      
  1182.  
  1183. memory_protect(on)
  1184.      int on;
  1185. { int i,beg,end= page(core_end);
  1186.   int writable=1;
  1187.   extern void   install_segmentation_catcher();
  1188.   if (first_protectable_page==0)
  1189.   {
  1190.     for (i=page_multiple; i< maxpage ; i++)
  1191.       if (type_map[i]!=t_other)
  1192.     break;
  1193.       else {
  1194.     /* We want page(0) to be non writable since that
  1195.        is the only check for 0 pointer in sgc */
  1196.       sgc_type_map[i] = SGC_PERM_WRITABLE;}
  1197.     first_protectable_page= ROUND_DOWN_PAGE_NO(i);}
  1198.   if(page_multiple > 1)
  1199.     fix_for_page_multiple(first_protectable_page,end);
  1200.     /* turning it off */
  1201.   if (on==0) {sgc_mprotect((first_protectable_page),
  1202.                (end - first_protectable_page), SGC_WRITABLE);
  1203.           install_segmentation_catcher();
  1204.           return;}
  1205.   /* write protect some pages by first write protecting them
  1206.      all and then selectively disabling */
  1207. /*  sgc_mprotect((first_protectable_page),
  1208.                (end - first_protectable_page), 0);
  1209. */
  1210.   INSTALL_MPROTECT_HANDLER;
  1211.   beg=first_protectable_page;
  1212.   writable = WRITABLE_PAGE_P(beg);
  1213.   for (i=beg ; ++i<= end; )
  1214.     {int wri = WRITABLE_PAGE_P(i);
  1215.      if ((wri==0 && writable)
  1216.          || (writable ==0  && wri)
  1217.      || i == end)
  1218.        /* it is changing */
  1219.        {if (writable)
  1220.       make_writable(beg,i);
  1221.     else
  1222.      sgc_mprotect(beg,i-beg,writable);
  1223.     writable = wri;
  1224.     beg = i;}
  1225.    }
  1226. }
  1227.  
  1228. void
  1229. siLsgc_on()
  1230. {if (vs_base==vs_top)
  1231.    {vs_base[0]=(sgc_enabled ? Ct :Cnil);
  1232.     vs_top=vs_base+1; return;}
  1233.  check_arg(1);
  1234.  if(vs_base[0]==Cnil)
  1235.      {sgc_quit();}
  1236.  else {sgc_start();}}
  1237.  
  1238.  
  1239. /* make permanently writable pages containing pointers p thru p+n-1 */
  1240.    
  1241.    
  1242. void
  1243. perm_writable(p,n)
  1244.      char *p;
  1245.      int n;
  1246. {int beg=page(p);
  1247.  int end=page(PAGE_ROUND_UP(p+n));
  1248.  int i,must_protect=0;
  1249.  beg = ROUND_DOWN_PAGE_NO(beg);
  1250.  end = ROUND_UP_PAGE_NO(end);
  1251.  for (i=beg ; i < end ; i++)
  1252.    {if (sgc_enabled & !(WRITABLE_PAGE_P(i))) must_protect = 1;
  1253.     sgc_type_map [i] |= SGC_PERM_WRITABLE;}
  1254.  if(must_protect) make_writable(beg,end);}
  1255.  
  1256.  
  1257.  
  1258. system_error()
  1259. {FEerror("System error");}
  1260.  
  1261.  
  1262.  
  1263.